home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / DOS / PRGMMING / CPUGET.ZIP / GETCPU3.BAS < prev    next >
Encoding:
BASIC Source File  |  1994-12-08  |  17.7 KB  |  631 lines
  1. '***********************  GETCPU3.BAS  *************************
  2. '
  3. '                  ███████┐ ███████┐ ██┐  ██┐
  4. '                  ██┌────┘ ██┌──██│ ██│  ██│
  5. '                  ██│      ███████│ ██│  ██│
  6. '                  ██│      ██┌────┘ ██│  ██│
  7. '                  ███████┐ ██│      ███████│
  8. '                  └──────┘ └─┘      └──────┘
  9. '
  10. 'This program uses an Assembly FUNCTION to get the CPU number.
  11. '
  12. 'It was made with the GETCPU2.OBJ Assembly program written by:
  13. '
  14. 'Cliff Brown      CIS# 71650,423        8-30-90
  15. '
  16. 'Found in a Public Domain file set on CompuServe as GETCPU.ZIP
  17. '
  18. 'Until now I was unable to figure out how to take GETCPU2.OBJ and
  19. 'make a Quick Library with it.... =and= a *.LIB as both are needed
  20. 'to use compile GETCPU2.OBJ into a standalone *.EXE program.
  21. '
  22. 'This file set includes those two libraries (*.QLB, *.LIB).
  23. '
  24. 'If you load GETCPU.QLB as your library in the QuickBASIC environment
  25. 'with the command:
  26. '
  27. '   QB.EXE GETCPU2.BAS /L GETCPU2.QLB
  28. '                
  29. '                note file name
  30. '
  31. 'you can compile a standalone *.EXE program which will display the CPU
  32. 'number up to a 80486. Don't know what happens when you run it with a
  33. 'PENTIUM, let me know.... We have no PENTIUM computers here.
  34. '
  35. 'Now.... if you want to =add= GETCPU2.OBJ to your QB.QLB, "all" you
  36. 'have to do is:
  37. '
  38. '   LINK /Q  QB.QLB GETCPU2.OBJ
  39. '
  40. 'Then make a *.LIB... (see beginning of text). Yeah... sure....
  41. '
  42. 'No it's not that easy, so I included the files:
  43. '
  44. '   CPU_QB.QLB and CPU_QB.LIB
  45. '
  46. 'which contain all the library code for CALL INTERRUPT -and- GETCPU2.QLB.
  47. '
  48. 'Use:
  49. '
  50. '   QB.EXE GETCPU3.BAS /L CPU_QB.QLB
  51. '                
  52. '                note file name
  53. '
  54. 'to use CALL INTERRUPT and get the CPU number.
  55. '
  56. 'John De Palma on CompuServe 76076,571
  57. '
  58. '12/8/94
  59. '=================================================================
  60.  
  61. DEFINT A-Z
  62.  
  63. 'CONST True = -1, False = 0
  64.  
  65. DECLARE FUNCTION DOSVersion! ()
  66. DECLARE SUB Splash2 (Choice%)
  67. DECLARE SUB StarFlag ()
  68. DECLARE SUB TwoColrs (Fgd%, Bkg%, Colr%)
  69. DECLARE FUNCTION Center% (text$)
  70. DECLARE FUNCTION OneColr% (Fgd%, Bkg%)
  71. DECLARE SUB TextBoxShadow (Row%, Col%, Message$, Outline%, Shadow%, Length%)
  72. DECLARE SUB LocateIt (Row%, text$)
  73. DECLARE SUB PressAnyKey ()
  74. DECLARE FUNCTION GetCPU2%
  75. DECLARE SUB GetColr (Fgd%, Bkg%, Colr%)
  76. DECLARE SUB SetBorder (ColrByte%)
  77.  
  78. 'executable code follows....
  79. '$INCLUDE: 'qb.bi'              'must have for CALL INTERRUPT
  80.  
  81. Copyright$ = "■Copyright (c) 1994 LearnWare (c) ■ John De Palma■"
  82.  
  83. DIM SHARED Regs AS RegType
  84. REDIM SHARED Box$(1 TO 56)
  85.  
  86. 'get the screen color and store it as an INTEGER before we change it
  87. CALL GetColr(Fgd%, Bkg%, RestoreColr%)
  88.  
  89. 'some multimedia stuff
  90. CLS
  91. BaseRow% = 2
  92.  
  93. 'First CALL INTERRUPT SUB
  94. CALL SetBorder(4)
  95.  
  96. CALL StarFlag
  97. SLEEP 2
  98. CALL PressAnyKey
  99. CALL SetBorder(3)
  100. COLOR 15, 1
  101. CALL Splash2(1)
  102. SLEEP 2
  103. CALL PressAnyKey
  104. CALL SetBorder(2)
  105.  
  106. COLOR 15, 4
  107. Row% = BaseRow%: Col% = 0: Outline% = 5: Shadow% = True: Length% = 2
  108. text$ = "A test for your CPU!"
  109. Message$ = SPACE$(LEN(text$))
  110. CALL TextBoxShadow(Row%, Col%, Message$, Outline%, Shadow%, Length%)
  111. CALL LocateIt(BaseRow% + 2, text$)
  112.  
  113. COLOR 14, 7
  114. Row% = BaseRow% + 8: Col% = 0: Outline% = 0: Shadow% = True: Length% = False
  115. Message$ = "CPU"
  116. CALL TextBoxShadow(Row%, Col%, Message$, Outline%, Shadow%, Length%)
  117.  
  118. 'Here's the Assembly CPU FUNCTION
  119. 'We get rid of the leading space in the number that is returned
  120. CPUtext$ = "80" + LTRIM$(STR$(GetCPU2%))
  121. CALL LocateIt(Row% + 2, CPUtext$)
  122.  
  123. COLOR 14, 7
  124. Row% = BaseRow% + 18: Col% = 5: Outline% = 0: Shadow% = True: Length% = False
  125. text$ = "DOS Version"
  126. Message$ = SPACE$(LEN(text$) - 4)
  127. CALL TextBoxShadow(Row%, Col%, Message$, Outline%, Shadow%, Length%)
  128.  
  129. 'Now a CALL INTERRUPT to get the DOS Version
  130. DOStext$ = LTRIM$(STR$(DOSVersion!))
  131. LOCATE Row% + 1, Col% + 1
  132. PRINT text$
  133. LOCATE Row% + 2, Col% + INT(LEN(text$) / 2)
  134. PRINT DOStext$
  135. SLEEP 2
  136. CALL PressAnyKey
  137. CALL SetBorder(14)
  138.  
  139. COLOR 13, 4
  140. Row% = BaseRow% + 15: Col% = 0: Outline% = 1: Shadow% = True: Length% = False
  141. text$ = "John De Palma on CompuServe 76076,571"
  142. Message$ = SPACE$(LEN(text$))
  143. CALL TextBoxShadow(Row%, Col%, Message$, Outline%, Shadow%, Length%)
  144. COLOR 15, 4
  145. CALL LocateIt(BaseRow% + 16, text$)
  146.   
  147. SLEEP 2
  148. CALL PressAnyKey
  149.  
  150. 'restore screen color
  151. CALL TwoColrs(Fgd%, Bkg%, RestoreColr%)
  152. 'set screen border to black
  153. CALL SetBorder(0)
  154. COLOR Fgd%, Bkg%
  155. CLS
  156. END
  157.  
  158. FUNCTION Center% (text$)
  159.     Center% = 41 - LEN(text$) \ 2
  160. END FUNCTION
  161.  
  162. SUB ColorIt (Fgd, Bkg)
  163.     COLOR Fgd, Bkg
  164. END SUB
  165.  
  166. FUNCTION DOSVersion! STATIC
  167.        
  168.         'DIM Regs AS RegType
  169.         Regs.ax = &H3000
  170.         INTERRUPT &H21, Regs, Regs
  171.         major% = Regs.ax MOD 256
  172.         minor% = Regs.ax \ 256
  173.         DOSVersion! = major% + (minor% / 100!)
  174.  
  175. END FUNCTION
  176.  
  177. SUB GetColr (Fgd%, Bkg%, Colr%) STATIC
  178.  
  179.     Colr% = SCREEN(1, 1, 1)
  180.  
  181.     Fgd% = (Colr% AND 128) \ 8 + (Colr% AND 15)
  182.     Bkg% = (Colr% AND 112) \ 16
  183.  
  184. END SUB
  185.  
  186. SUB IsCursor (IfTrue%)
  187.     'Like this better than two SUBs of CursorOn and CursorOff
  188.     'Especially with the trouble changing the code with QuickPak
  189.     'and PDQ
  190.     IF IfTrue% = True THEN
  191.         'LOCATE , , 1, 4, 7     'big cursor
  192.         LOCATE , , 1
  193.     ELSE
  194.         LOCATE , , 0
  195.     END IF
  196. END SUB
  197.  
  198. DEFSNG A-Z
  199. SUB LocateIt (Row%, text$)
  200.      LOCATE Row%, 41 - (LEN(text$)) \ 2
  201.      PRINT text$;
  202. END SUB
  203.  
  204. DEFINT A-Z
  205. FUNCTION OneColr% (Fgd%, Bkg%)
  206.     OneColr% = (Fgd% AND 16) * 8 + ((Bkg% AND 7) * 16 + (Fgd% AND 15))
  207. END FUNCTION
  208.  
  209. SUB PressAnyKey
  210.   
  211.     text$ = "  PRESS: A Key to Continue...  "
  212.     Row% = CSRLIN
  213.     Col% = POS(0)
  214.     'get color on row 24
  215.     Colr% = SCREEN(24, Center(text$), 1)
  216.     CALL TwoColrs(Fgd%, Bkgd%, Colr%)
  217.     LOCATE 24, Center(text$)
  218.     COLOR 11, 0
  219.     GOSUB StoreText
  220.   
  221.     PRINT text$;
  222.     COLOR Fgd%, Bkgd%
  223.     WHILE INKEY$ = "": WEND
  224.     WHILE INKEY$ <> "": WEND        'need this to remove the key press
  225.     LOCATE 24, Center(text$)
  226.     PRINT StoreScreenLine$;
  227.     'PRINT SPACE$(LEN(text$));
  228.     LOCATE Row%, Col%
  229.     EXIT SUB
  230. StoreText:
  231.   
  232.     FOR i% = 1 TO LEN(text$)
  233.         StoreScreenLine$ = StoreScreenLine$ + CHR$(SCREEN(CSRLIN, i%))
  234.     NEXT
  235.     RETURN
  236. END SUB
  237.  
  238. SUB SetBorder (ColrByte%) STATIC
  239.  
  240.         'DIM Regs AS RegType
  241.         Regs.ax = &H1001
  242.         Regs.bx = ColrByte% * &H100
  243.         CALL INTERRUPT(&H10, Regs, Regs)
  244.  
  245. END SUB
  246.  
  247. SUB Splash2 (Choice%)
  248. 'prints a full screen of: ⌠⌠⌠⌠⌠⌠⌠⌠
  249. '                         ⌡⌡⌡⌡⌡⌡⌡⌡
  250.  
  251. SELECT CASE Choice%
  252.     CASE 1
  253.         Char1% = 244
  254.         Char2% = 245
  255.     CASE 2
  256.         Char1% = 174
  257.         Char2% = 175
  258.     CASE 3
  259.         Char1% = 242
  260.         Char2% = 243
  261.     CASE 4
  262.         Char1% = 47
  263.         Char2% = 92
  264.     CASE 5
  265.         Char1% = 220
  266.         Char2% = 240
  267.     CASE 6
  268.         Char1% = 221
  269.         Char2% = 222
  270.     CASE 7
  271.         Char1% = 180
  272.         Char2% = 195
  273.     CASE 8
  274.         Char1% = 254
  275.         Char2% = 222
  276.     CASE 9
  277.         Char1% = 146
  278.         Char2% = 158
  279.     CASE 10
  280.         Char1% = 159
  281.         Char2% = 159
  282.     CASE ELSE
  283.         Char1% = 244
  284.         Char2% = 245
  285. END SELECT
  286.  
  287.     FOR i = 1 TO 25 STEP 2
  288.         LOCATE i, 1
  289.         PRINT STRING$(80, Char1%);
  290.     NEXT
  291.     FOR i = 2 TO 24 STEP 2
  292.         LOCATE i, 1
  293.         PRINT STRING$(80, Char2%);
  294.     NEXT
  295.  
  296. END SUB
  297.  
  298. SUB StarFlag
  299. COLOR 7, 0
  300. CLS
  301. LOCATE 4, 1
  302. PRINT " "; : COLOR 1, 7: PRINT "█"; : COLOR 15, 1: PRINT "";
  303. COLOR 1, 7: PRINT "███"; : COLOR 15, 1: PRINT " ";
  304. COLOR 1, 7: PRINT "█"; : COLOR 15, 1: PRINT "";
  305. COLOR 1, 7: PRINT "█████"; : COLOR 15, 1: PRINT "";
  306. COLOR 1, 7: PRINT "█████"; : COLOR 15, 1: PRINT "";
  307. COLOR 1, 7: PRINT "█████"; : COLOR 15, 1: PRINT "";
  308. COLOR 1, 7: PRINT "█████"; : COLOR 15, 1: PRINT "";
  309. COLOR 1, 7: PRINT "████"; : COLOR 4, 7: PRINT "██████████████████████████████████████████";
  310. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "███";
  311. COLOR 15, 1: PRINT "  "; : COLOR 1, 7: PRINT "████";
  312. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  313. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  314. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  315. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  316. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  317. COLOR 15, 4: PRINT "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄";
  318. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "█";
  319. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  320. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  321. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  322. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  323. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  324. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  325. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  326. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "████";
  327. COLOR 15, 7: PRINT "██████████████████████████████████████████";
  328. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "████";
  329. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "████";
  330. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  331. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  332. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  333. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  334. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  335. COLOR 4, 7: PRINT "██████████████████████████████████████████";
  336. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "█";
  337. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  338. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  339. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  340. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  341. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  342. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  343. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  344. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "████";
  345. COLOR 15, 4: PRINT "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄";
  346. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "███";
  347. COLOR 15, 1: PRINT "  "; : COLOR 1, 7: PRINT "████";
  348. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  349. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  350. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  351. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  352. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  353. COLOR 15, 7: PRINT "██████████████████████████████████████████";
  354. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "█";
  355. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  356. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  357. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  358. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  359. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  360. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  361. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  362. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "████";
  363. COLOR 4, 7: PRINT "██████████████████████████████████████████";
  364. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "███";
  365. COLOR 15, 1: PRINT "  "; : COLOR 1, 7: PRINT "████";
  366. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  367. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  368. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  369. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  370. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  371. COLOR 15, 4: PRINT "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄";
  372. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "█";
  373. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  374. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  375. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "█";
  376. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  377. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  378. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  379. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  380. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "████";
  381. COLOR 15, 7: PRINT "██████████████████████████████████████████";
  382. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 1, 7: PRINT "████";
  383. COLOR 15, 1: PRINT " "; : COLOR 1, 7: PRINT "████";
  384. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  385. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  386. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  387. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█████";
  388. COLOR 15, 1: PRINT ""; : COLOR 1, 7: PRINT "█";
  389. COLOR 4, 7: PRINT "██████████████████████████████████████████";
  390. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 15, 1: PRINT "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄";
  391. COLOR 15, 4: PRINT "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄";
  392. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 15, 7: PRINT "██████████████████████████████████████████████████████████████████████████████";
  393. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 4, 7: PRINT "██████████████████████████████████████████████████████████████████████████████";
  394. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 15, 4: PRINT "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄";
  395. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 15, 7: PRINT "██████████████████████████████████████████████████████████████████████████████";
  396. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 4, 7: PRINT "██████████████████████████████████████████████████████████████████████████████";
  397. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 15, 4: PRINT "▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄";
  398. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 15, 7: PRINT "██████████████████████████████████████████████████████████████████████████████";
  399. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 4, 7: PRINT "██████████████████████████████████████████████████████████████████████████████";
  400. COLOR 7, 0: PRINT " "; : PRINT " "; : COLOR 4, 0: PRINT "▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀ ";
  401.  
  402. END SUB
  403.  
  404. SUB TextBoxShadow (Row%, Col%, Message$, Outline%, Shadow%, Length%)
  405.   
  406.     'Adding other ancillary SUBs as "GOSUB"s so that they
  407.     'do not need to be imported into a new module.
  408.     'edited to omit the SUB TwoColr(Fgd%,Bkg,Colr%)
  409.     'and tested Sun  08-21-1994  21:25:34
  410.  
  411.     'got to have a REDIM SHARED Box$(1 to 56) in main module
  412.     'Other SUB/FUNCTIONs still needed for this SUB are:
  413.     'SUB
  414.     'LocateIt(Row%, Text$)
  415.     'FUNCTION
  416.     'Center% (text$)
  417.     '
  418.     'Puts a message into a three line box -or-
  419.     'draw a box without a message using Message$=SPACE$(x)
  420.     'where "x" is the width of the box and Length%= number of lines > 3
  421.     'Boxes are centered if Col% = 0; else left side of box = Col%.
  422.     'Boxes display a true shadow if Shadow% <> 0
  423.     'True = -1: False = 0
  424.  
  425.     STATIC BoxReadFlag
  426.     Message$ = LEFT$(Message$, 60)
  427.     BoxWidth% = LEN(Message$) + 4
  428.     SELECT CASE Outline%
  429.         CASE 0
  430.             j = 8 * 6 + 1
  431.         CASE 1
  432.             j = 1
  433.         CASE 2
  434.             j = 8 + 1
  435.         CASE 3
  436.             j = 8 * 2 + 1
  437.         CASE 4
  438.             j = 8 * 3 + 1
  439.         CASE 5
  440.             j = 8 * 4 + 1
  441.         CASE 6
  442.             j = 8 * 5 + 1
  443.         CASE ELSE
  444.             j = 8 * 6 + 1
  445.     END SELECT
  446.  
  447.     IF BoxReadFlag THEN GOTO Skip
  448.     REDIM Box$(1 TO 56)
  449.     BoxReadFlag = True
  450.  
  451. 'single line box
  452.     Box$(1) = "┌"
  453.     Box$(2) = "─"
  454.     Box$(3) = "┐"
  455.     Box$(4) = "│"
  456.     Box$(5) = "│"
  457.     Box$(6) = "└"
  458.     Box$(7) = "─"
  459.     Box$(8) = "┘"
  460.  
  461. 'double top box
  462.     Box$(9) = "╒"
  463.     Box$(10) = "═"
  464.     Box$(11) = "╕"
  465.     Box$(12) = "│"
  466.     Box$(13) = "│"
  467.     Box$(14) = "╘"
  468.     Box$(15) = "═"
  469.     Box$(16) = "╛"
  470.  
  471. 'double side box
  472.     Box$(17) = "╓"
  473.     Box$(18) = "─"
  474.     Box$(19) = "╖"
  475.     Box$(20) = "║"
  476.     Box$(21) = "║"
  477.     Box$(22) = "╙"
  478.     Box$(23) = "─"
  479.     Box$(24) = "╜"
  480.  
  481. 'double box
  482.     Box$(25) = "╔"
  483.     Box$(26) = "═"
  484.     Box$(27) = "╗"
  485.     Box$(28) = "║"
  486.     Box$(29) = "║"
  487.     Box$(30) = "╚"
  488.     Box$(31) = "═"
  489.     Box$(32) = "╝"
  490.  
  491. 'bold box
  492.     Box$(33) = "█"
  493.     Box$(34) = "▀"
  494.     Box$(35) = "█"
  495.     Box$(36) = "█"
  496.     Box$(37) = "█"
  497.     Box$(38) = "█"
  498.     Box$(39) = "▄"
  499.     Box$(40) = "█"
  500.  
  501. 'bold and thick box
  502.     Box$(41) = "█"
  503.     Box$(42) = "█"
  504.     Box$(43) = "█"
  505.     Box$(44) = "█"
  506.     Box$(45) = "█"
  507.     Box$(46) = "█"
  508.     Box$(47) = "█"
  509.     Box$(48) = "█"
  510.  
  511. 'no box
  512.     Box$(49) = " "
  513.     Box$(50) = " "
  514.     Box$(51) = " "
  515.     Box$(52) = " "
  516.     Box$(53) = " "
  517.     Box$(54) = " "
  518.     Box$(55) = " "
  519.     Box$(56) = " "
  520.  
  521. Skip:
  522.  
  523.    
  524.   
  525.     IF Col% = 0 THEN
  526.  
  527.             BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  528.             GOSUB Location
  529.             'CALL LocateIt(Row%, BoxText$)
  530.             Row2% = CSRLIN: Col2% = POS(0)
  531.             Colr% = SCREEN(Row2%, Col2% - 1, 1)
  532.             'GOSUB GetTwoColors
  533.             CALL TwoColrs(Fgd%, Bkg%, Colr%)
  534.    
  535.             FOR i = 1 TO Length% + 1
  536.             BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  537.             'GOSUB Location
  538.             CALL LocateIt(Row% + i, BoxText$)
  539.  
  540.             IF Shadow% THEN
  541.                 COLOR 7, 0
  542.                     FOR k = 1 TO 2
  543.                         PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  544.                     NEXT
  545.                 COLOR Fgd%, Bkg%
  546.             END IF
  547.             NEXT i
  548.  
  549.             BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  550.             'GOSUB Location
  551.             CALL LocateIt(Row% + i, BoxText$)
  552.      
  553.             IF Shadow% THEN
  554.                 COLOR 7, 0
  555.                 FOR k = 1 TO 2
  556.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  557.                 NEXT
  558.             'COLOR Fgd%, Bkg%
  559.    
  560.             COLOR 7, 0
  561.             LOCATE Row% + i + 1, Center(BoxText$) + 2
  562.      
  563.                 FOR k = 1 TO BoxWidth% + 2
  564.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  565.                 NEXT
  566.                 COLOR Fgd%, Bkg%
  567.             END IF
  568.     ELSE
  569.  
  570.             BoxText$ = Box$(j) + STRING$(BoxWidth%, Box$(j + 1)) + Box$(j + 2)
  571.             LOCATE Row%, Col%
  572.             PRINT BoxText$;
  573.             Row2% = CSRLIN: Col2% = POS(0)
  574.             Colr% = SCREEN(Row2%, Col2% - 1, 1)
  575.             GOSUB GetTwoColors
  576.                         'CALL TwoColrs(Fgd%, Bkg%, Colr%)
  577.  
  578.             FOR i = 1 TO Length% + 1
  579.             BoxText$ = Box$(j + 3) + "  " + Message$ + "  " + Box$(j + 4)
  580.             LOCATE Row% + i, Col%
  581.             PRINT BoxText$;
  582.      
  583.             IF Shadow% THEN
  584.                 COLOR 7, 0
  585.                 FOR k = 1 TO 2
  586.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  587.                 NEXT
  588.                 COLOR Fgd%, Bkg%
  589.             END IF
  590.      
  591.             NEXT i
  592.  
  593.             BoxText$ = Box$(j + 5) + STRING$(BoxWidth%, Box$(j + 6)) + Box$(j + 7)
  594.             LOCATE Row% + i, Col%
  595.             PRINT BoxText$;
  596.      
  597.             IF Shadow% THEN
  598.                 COLOR 7, 0
  599.                 FOR k = 1 TO 2
  600.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  601.                 NEXT
  602.               
  603.                 LOCATE Row% + i + 1, Col% + 2
  604.                 FOR k = 1 TO BoxWidth% + 2
  605.                     PRINT CHR$(SCREEN(CSRLIN, POS(0)));
  606.                 NEXT
  607.                 COLOR Fgd%, Bkg%
  608.             END IF
  609.  
  610.     END IF
  611.     EXIT SUB
  612. GetTwoColors:
  613.     Fgd% = (Colr% AND 128) \ 8 + (Colr% AND 15)
  614.     Bkg% = (Colr% AND 112) \ 16
  615. RETURN
  616.  
  617. Location:
  618.     LOCATE Row%, 41 - (LEN(BoxText$)) \ 2
  619.     PRINT BoxText$;
  620. RETURN
  621.  
  622. END SUB
  623.  
  624. SUB TwoColrs (Fgd%, Bkg%, Colr%)
  625.  
  626.     Fgd% = (Colr% AND 128) \ 8 + (Colr% AND 15)
  627.     Bkg% = (Colr% AND 112) \ 16
  628.  
  629. END SUB
  630.  
  631.